home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_200 / 251_01 / objects.adi < prev    next >
Text File  |  1987-10-27  |  13KB  |  556 lines
  1. ; This is the object-oriented runtime package
  2. ; by David Betz
  3. ; July 19, 1986
  4.  
  5. ; ********************
  6. ; PROPERTY DEFINITIONS
  7. ; ********************
  8.  
  9. ; These properties will be used for connections between locations
  10. (property
  11.   north            ; the location to the north
  12.   south            ; the location to the south
  13.   east            ; the location to the east
  14.   west            ; the location to the west
  15.   up            ; the location above
  16.   down)            ; the location below
  17.  
  18. ; Basic object properties
  19. (property
  20.   initial-location    ; the initial location of a "thing"
  21.   description        ; the "long" description of a location
  22.   short-description)    ; the "short" description of a location
  23.  
  24. ; Connection properties
  25. (property
  26.   parent        ; the parent of an object
  27.   sibling        ; the next sibling of an object
  28.   child)        ; the first child of an object
  29.  
  30. ; Location properties
  31. (property
  32.   visited)        ; true if location has been visited by player
  33.  
  34. ; Portal properties
  35. (property
  36.   closed        ; true if the portal is closed
  37.   locked        ; true if the portal is locked
  38.   key            ; key to unlock the portal
  39.   other-side)        ; the other portal in a pair
  40.  
  41. ; **********************
  42. ; VOCABULARY DEFINITIONS
  43. ; **********************
  44.  
  45. ; Some abbreviations for common commands
  46. (synonym north n)
  47. (synonym south s)
  48. (synonym east e)
  49. (synonym west w)
  50. (synonym inventory i)
  51.  
  52. ; Define the basic vocabulary
  53. (conjunction and)
  54. (article the that)
  55.  
  56. ; ********************
  57. ; VARIABLE DEFINITIONS
  58. ; ********************
  59.  
  60. (variable
  61.   curloc        ; the location of the player character
  62.   %actor        ; the actor object
  63.   %dobject        ; the direct object
  64.   %iobject)        ; the indirect object
  65.  
  66. ; *********************
  67. ; CONNECTION PRIMITIVES
  68. ; *********************
  69.  
  70. ; Connect an object to a parent
  71. (define (connect p c)
  72.   (setp c parent p)
  73.   (setp c sibling (getp p child))
  74.   (setp p child c))
  75.  
  76. ; Connect all objects to their initial parents
  77. (define (connect-all &aux obj maxp1 par)
  78.   (setq obj 1)
  79.   (setq maxp1 (+ $ocount 1))
  80.   (while (< obj maxp1)
  81.     (if (setq par (getp obj initial-location))
  82.       (connect par obj))
  83.     (setq obj (+ obj 1))))
  84.  
  85. ; Disconnect an object from its current parent
  86. (define (disconnect obj &aux this prev)
  87.   (setq this (getp (getp obj parent) child))
  88.   (setq prev nil)
  89.   (while this
  90.     (if (= this obj)
  91.       (progn
  92.     (if prev
  93.       (setp prev sibling (getp this sibling))
  94.       (setp (getp this parent) child (getp this sibling)))
  95.     (setp this parent nil)
  96.     (return)))
  97.     (setq prev this)
  98.     (setq this (getp this sibling))))
  99.  
  100. ; Print the contents of an object (used by "look")
  101. (define (print-contents obj prop &aux desc)
  102.   (setq obj (getp obj child))
  103.   (while obj
  104.     (if (setq desc (getp obj prop))
  105.       (progn
  106.     (print " ")
  107.     (print desc)))
  108.     (setq obj (getp obj sibling))))
  109.  
  110. ; List the contents of an object (used for "inventory")
  111. (define (list-contents obj prop &aux desc)
  112.   (setq obj (getp obj child))
  113.   (while obj
  114.     (if (setq desc (getp obj prop))
  115.       (progn
  116.     (print "\t")
  117.     (print desc)
  118.     (terpri)))
  119.     (setq obj (getp obj sibling))))
  120.  
  121. ; ************************
  122. ; OBJECT CLASS DEFINITIONS
  123. ; ************************
  124.  
  125. ; ***********************
  126. ; The "basic-thing" class
  127. ; ***********************
  128.  
  129. (object basic-thing
  130.   (property
  131.     parent nil        ; the parent of this object
  132.     sibling nil))    ; the next sibling of this object
  133.  
  134. ; ***************************
  135. ; The "location" object class
  136. ; ***************************
  137.  
  138. (object location
  139.   (property
  140.     child nil        ; the first object in this location
  141.     visited nil)    ; has the player been here yet?
  142.   (method (knock? obj)
  143.     T)
  144.   (method (enter obj)
  145.     (connect self obj)
  146.     T)
  147.   (method (leave obj dir &aux loc)
  148.     (if (setq loc (getp self dir))
  149.       (if (send loc knock? obj)
  150.         (progn
  151.           (disconnect obj)
  152.           (send loc enter obj)))
  153.       (progn
  154.         (print "There is no exit in that direction.\n")
  155.         nil)))
  156.   (method (describe)
  157.     (if (getp self visited)
  158.       (print (getp self short-description))
  159.       (progn
  160.         (print (getp self description))
  161.         (print-contents self description)
  162.         (setp self visited t)))
  163.     (terpri)))
  164.  
  165.  
  166. ; ******************
  167. ; The "portal" class
  168. ; ******************
  169.  
  170. (basic-thing portal
  171.   (method (knock? obj)
  172.     (if (getp self closed)
  173.       (progn
  174.         (print "The ")
  175.         (print (getp self short-description))
  176.         (print " is closed!\n")
  177.         nil)
  178.       T))
  179.   (method (enter obj)
  180.     (connect (getp (getp self other-side) parent) obj))
  181.   (method (open)
  182.     (if (not (getp self closed))
  183.       (progn
  184.         (print "The ")
  185.         (print (getp self short-description))
  186.         (print " is already open!\n")
  187.         nil)
  188.       (if (getp self locked)
  189.         (progn
  190.           (print "The ")
  191.           (print (getp self short-description))
  192.           (print " is locked!\n")
  193.           nil)
  194.         (progn
  195.           (setp self closed nil)
  196.           T))))
  197.   (method (close)
  198.     (if (getp self closed)
  199.       (progn
  200.         (print "The ")
  201.         (print (getp self short-description))
  202.         (print " is already closed!\n")
  203.         nil)
  204.       (progn
  205.         (setp self closed T)
  206.         T)))
  207.   (method (lock thekey)
  208.     (if (not (getp self closed))
  209.       (progn
  210.         (print "The ")
  211.         (print (getp self short-description))
  212.         (print " is not closed!\n")
  213.         nil)
  214.       (if (getp self locked)
  215.         (progn
  216.           (print "The ")
  217.           (print (getp self short-description))
  218.           (print " is already locked!\n")
  219.           nil)
  220.         (if (not (= thekey (getp self key)))
  221.           (progn
  222.             (print "It doesn't fit the lock!\n")
  223.             nil)
  224.           (progn
  225.             (setp self locked t)
  226.             T)))))
  227.   (method (unlock thekey)
  228.     (if (not (getp self closed))
  229.       (progn
  230.         (print "The ")
  231.         (print (getp self short-description))
  232.         (print " is already open!\n")
  233.         nil)
  234.       (if (not (getp self locked))
  235.         (progn
  236.           (print "The ")
  237.           (print (getp self short-description))
  238.           (print " is not locked!\n")
  239.            nil)
  240.         (if (not (= thekey (getp self key)))
  241.           (progn
  242.             (print "It doesn't fit the lock!\n")
  243.             nil)
  244.           (progn
  245.             (setp self locked nil)
  246.             T))))))
  247.  
  248. ; *****************
  249. ; The "actor" class
  250. ; *****************
  251.  
  252. (basic-thing actor
  253.   (property
  254.     child nil)        ; the first "thing" carried by this actor
  255.   (method (move dir)
  256.     (send (getp self parent) leave self dir))
  257.   (method (take obj)
  258.     (disconnect obj)
  259.     (connect self obj))
  260.   (method (drop obj)
  261.     (disconnect obj)
  262.     (connect (getp self parent) obj))
  263.   (method (carrying? obj)
  264.     (= (getp obj parent) self))
  265.   (method (inventory)
  266.     (cond ((getp %actor child)
  267.            (print "You are carrying:\n")
  268.            (list-contents %actor short-description))
  269.           (T (print "You are empty-handed.\n")))))
  270.  
  271. ; *****************
  272. ; The "thing" class (things that can be taken)
  273. ; *****************
  274.  
  275. (basic-thing thing
  276.   (class-property
  277.     takeable t))
  278.  
  279. ; ****************************
  280. ; The "stationary-thing" class (things that can't be moved)
  281. ; ****************************
  282.  
  283. (basic-thing stationary-thing)
  284.  
  285. ; ***********************
  286. ; MISCELLANEOUS FUNCTIONS
  287. ; ***********************
  288.  
  289. ; Complain about a noun phrase
  290. (define (complain head n tail)
  291.   (print head)
  292.   (print-noun n)
  293.   (print tail)
  294.   (abort))
  295.  
  296. ; Find an object in a location
  297. (define (findobject loc n &aux this found)
  298.   (setq this (getp loc child))
  299.   (setq found nil)
  300.   (while this
  301.     (if (match this n)
  302.       (if found
  303.         (complain "I don't know which " n " you mean!\n")
  304.     (setq found this)))
  305.     (setq this (getp this sibling)))
  306.   found)
  307.  
  308. ; Find an object in the player's current location
  309. ;  (or in the player's inventory)
  310. (define (in-location n &aux obj)
  311.   (if (or (setq obj (findobject curloc n))
  312.           (setq obj (findobject %actor n)))
  313.     obj
  314.     (complain "I don't see a " n " here!\n")))
  315.  
  316. ; Find an object